home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1997: The Complete Utilities Toolkit / macworld-complete-utilities-1997.iso / Programming / Little Smalltalk v3.1.5 / Smalltalk Source / browser.st < prev    next >
Encoding:
Text File  |  1995-07-03  |  8.5 KB  |  338 lines  |  [TEXT/KAHL]
  1. * ***
  2. * Methods for a class browser
  3. *
  4. * Julian Barkway (c) September 1994 All rights reserved. 
  5. *
  6. * v3.1.0 Initial release
  7. * v3.1.1 -
  8. * v3.1.2 - Changed to allow for different actions for double and single clicks.
  9. *         - Increased use of cascades.
  10. *         - Class>>addSubClass:instanceVariableNames: patched to let through embedded
  11. *           digits.
  12. * v3.1.3 - Dictionary pane no longer gives error if clicked on when empty.
  13. * v3.1.5 - Browser completely re-designed to reflect improvements in the basic protocol
  14. *          for Pane and SelectListPane. Protocol for DictionaryPane absorbed into SelectListPane.
  15. *
  16. * ***
  17.  
  18. Class    BrowserWindow Window browser
  19.  
  20. Class    ClassPane SelectListPane
  21. Class    MethodPane SelectListPane
  22. Class    EditorPane TextPane theClass method compile
  23.  
  24. Class    Browser Object cp mp ep
  25.  
  26. *
  27. * addSubClass:... patched so that it doesn't remove numbers embedded in instance 
  28. * variable names.  The downside is that it will let through some illegal names, but 
  29. * since the compiler will trap these when they are used it probably isn't too bad a
  30. * side-effect.
  31. *
  32. Methods Class 'creation'
  33.     addSubClass: aSymbol instanceVariableNames: aString    | newClass |
  34.         newClass <- Class new; name: aSymbol; superClass: self;
  35.                 variables: 
  36.                   (aString words: [:x | x isAlphaNumeric ]).
  37.         aSymbol assign: newClass.
  38.         classes at: aSymbol put: newClass
  39. ]
  40.  
  41. Methods Class 'display'
  42.     editClass
  43.     " Return an addSubClass:instanceVariableNames: message, filled in with
  44.       data from the Class, ready for evaluation "
  45.     | txt |
  46.         txt <- (self superClass) printString , ' addSubClass: #' , 
  47.                 self printString, newLine , '   instanceVariableNames: '''.
  48.         (variables notNil) ifTrue: [
  49.             variables do: [ :var | txt <- (txt , (var asString) , ' ') ]
  50.         ].
  51.         txt <- txt , ''''.
  52.         ^ txt.
  53. ]
  54.  
  55. *
  56. * We sub-class Window to allow the 'close' message to be neatly trapped without
  57. * needing to make Browser a sub-class of Window (which it clearly isn't)
  58. * 
  59. Methods BrowserWindow 'all'
  60.     openAt: aPosition withSize: aSize
  61.         (title = '') ifTrue: [       " Only false when restoring a saveImage'd window "
  62.             self title: 'Browser ' , (nextBrowserNum asString).
  63.             nextBrowserNum <- nextBrowserNum + 1
  64.         ].
  65.         super openAt: aPosition withSize: aSize
  66. |
  67.     close    | reply |
  68.         (self wantsSave) ifTrue: [
  69.             reply <- smalltalk inquire: ('Save contents of window ', self title, '?').
  70.             (reply isNil) ifTrue: [                "Note: can return nil for Cancel"
  71.                 ^ nil
  72.             ]. 
  73.             reply  ifTrue: [
  74.                 ((self mainPane) saveContents: 1) ifFalse: [
  75.                     ^ nil            "User cancelled save operation"
  76.                 ]
  77.             ]
  78.         ].
  79.         super close.
  80.         browser close
  81. |
  82.     browser: aBrowser
  83.         browser <- aBrowser.
  84. ]
  85.  
  86. *
  87. * A selectable list of all classes in the system.
  88. *
  89. Methods ClassPane 'all'
  90.     openOn: aClassDictionary in: aWindow withSizeFrom: topLeft to: bottomRight
  91.         super openOn: aClassDictionary in: aWindow withSizeFrom: topLeft to: bottomRight.
  92.         self font: 'geneva'; fontSize: 9; typeFace: 2;
  93.              button1Action: #prepareMethodPane:;
  94.              button1DoubleClick: #selectClass:;
  95.              owner: self;
  96.              setText
  97. |
  98.     createPopUpMenu
  99.         pMenu <- PopUpMenu new; title: ''; owner: self; create.
  100.         pMenu addItem: 'Browse Class'     action: #browseClass;
  101.               addItem: 'Inspect Class'    action: #inspectClass;
  102.               addItem: 'Add New Class'    action: #addClass;
  103.               addItem: 'Remove Class'    action: #removeClass;
  104.               disableItem: 1; disableItem: 4.
  105. |
  106.     selectClass: aPoint
  107.         self withSelectedItemSend: #showMethodsForClass: to: parent.
  108. |
  109.     browseClass    
  110.         " browse the given class - modified for v3.1.5"
  111.         self withSelectedItemSend: #editClass: to: parent.
  112. |
  113.     inspectClass
  114.         "Added for v3.1.5"
  115.         self sendToSelectedItem: #inspect
  116. |
  117.     addClass    
  118.         " add a new class "
  119.         parent editNewClass
  120. |
  121.     removeClass
  122.         " Will remove class from symbols dictionary
  123.           when we can figure out how... It's not just 
  124.           a simple matter of invoking removeKey: "
  125.         ^ nil
  126. |
  127.     prepareMethodPane: aPoint
  128.         pMenu enableItem: 1; enableItem: 2; enableItem: 3.
  129.         "pMenu enableItem: 4." "Class removal disabled for now..."
  130.         parent prepareMethodPane
  131. ]
  132.  
  133. *
  134. * A selectable list of all methods pertaining to a selected class
  135. *
  136. Methods MethodPane 'all'
  137.     openOn: aMethodDictionary in: aWindow withSizeFrom: topLeft to: bottomRight
  138.         super openOn: aMethodDictionary in: aWindow withSizeFrom: topLeft to: bottomRight.
  139.         self font: 'geneva'; fontSize: 9; typeFace: 2;
  140.              button1Action: #prepareEditor:;
  141.              button1DoubleClick: #selectMethod:;
  142.              owner: self.
  143. |
  144.     createPopUpMenu
  145.         pMenu <- PopUpMenu new; title: ''; owner: self; create.
  146.         pMenu addItem: 'Add New Method'    action: #addMethod;
  147.               addItem: 'Remove Method'    action: #removeMethod;
  148.               disableItem: 1; disableItem: 2.
  149. |
  150.     prepareEditor: aPoint
  151.         parent cancelEditor.
  152.         pMenu enableItem: 2
  153. |
  154.     selectMethod: aPoint 
  155.         self withSelectedItemSend: #editMethod: to: parent.
  156. |
  157.     addMethod
  158.         method <- Method new.
  159.         parent addNewMethod.
  160. |
  161.     removeMethod
  162.         self withSelectedItemSend: #removeMethod: to: self
  163. |
  164.     removeMethod: m
  165.     | t |
  166.         " Remove given method from currently selected class "
  167.         (m notNil) ifTrue: [
  168.             t <- (smalltalk inquire: 'Remove method ''', (m name), '''?').
  169.             (t isNil) ifTrue: [
  170.                 ^ nil
  171.             ].
  172.             t ifTrue: [
  173.                 collection removeKey: (m name).
  174.                 self setText.
  175.                 pMenu disableItem: 2
  176.             ]
  177.         ]
  178. |
  179.     showMethodsForClass: c
  180.         self collection: (c methods); setText.
  181.         pMenu enableItem: 1; disableItem: 2.
  182.         parent setClass: c
  183. |
  184.     clearPane
  185.         self clearAllText.
  186.         pMenu disableItem: 1; disableItem: 2.
  187.         parent cancelEditor
  188. ]
  189.  
  190. *
  191. * A pane which allows methods and classes to be viewed, edited and compiled into the system.
  192. *
  193. Methods EditorPane 'all'
  194.     openIn: aWindow withSizeFrom: topLeft to: bottomRight
  195.         self boundsFrom: topLeft to: bottomRight;
  196.              owner: self;
  197.              attachTo: aWindow withSizing: (1 @ 1);
  198.              font: 'monaco'; fontSize: 9.
  199. |
  200.     parent: anObject
  201.         parent <- anObject
  202. |
  203.     createPopUpMenu
  204.         pMenu <- PopUpMenu new; 
  205.             owner: self;
  206.             title: '';
  207.             create.
  208.         pMenu addItem: 'Accept' action: #accept;
  209.               addItem: 'Cancel' action: #cancel;
  210.               disableItem: 1; disableItem: 2.
  211.         compile <- true
  212. |
  213.     setClass: c
  214.         theClass <- c
  215. |
  216.     editClass: c
  217.         self clearAllText.
  218.         self print: (c editClass).
  219.         theClass <- c.
  220.         compile  <- false.
  221.         pMenu disableItem: 1; enableItem: 2.
  222. |
  223.     editNewClass
  224.         self clearAllText;
  225.            print: 'superClass addSubClass: #nameOfClass ', newLine,
  226.                    '  instanceVariableNames: ''var1 var2'' '.
  227.         compile <- false.
  228.         pMenu enableItem: 1; enableItem: 2.
  229. |
  230.     editMethod: m
  231.         self print: m text.
  232.         compile <- true.
  233.         method <- m.
  234.         pMenu enableItem: 1; enableItem: 2
  235. |
  236.     editNewMethod
  237.         self clearAllText;
  238.              print: '  "A comment stating the method''s function"' , newLine;
  239.              print: '  messageSelector: argumentNames " -- argument names optional"', newLine;
  240.              print: '    | temporaries | "-- temporaries optional"', newLine;
  241.              print: '    body of method', newLine.
  242.         compile <- true.
  243.         method  <- Method new.
  244.         pMenu enableItem: 1; enableItem: 2.
  245. |
  246.     accept
  247.         compile ifTrue:  [ self compile   ]
  248.                 ifFalse: [ self doCommand ]
  249. |
  250.     cancel
  251.         self clearAllText.
  252.         pMenu disableItem: 1; disableItem: 2.
  253.  
  254. |
  255.     compile
  256.         method text: (self text).
  257.         (method compileWithClass: theClass)
  258.             ifTrue: [ 
  259.                 theClass methods at: method name put: method.
  260.                 parent showMethods
  261.             ].
  262. |
  263.     doCommand
  264.         " accept tw command "
  265.         [ self text execute. parent showClasses ] fork.
  266. |
  267.     close
  268.         pMenu dispose
  269. ]
  270.  
  271. *
  272. * The actual browser object is just a co-ordinator for the three panes which do
  273. * the real work.
  274. *
  275. Methods Browser 'all'
  276.     open 
  277.     | bwin maxW maxH | 
  278.         maxW <- (smalltalk getMaxScreenArea) right.
  279.         maxW <- 450 min: (maxW - 70).
  280.         maxH <- (smalltalk getMaxScreenArea) bottom.
  281.         maxH <- 500 min: (maxH - 70).
  282.         bwin <- BrowserWindow new; 
  283.             browser: self;
  284.             openAt: (20@60) withSize: (maxW@maxH).
  285.         self makePanes: bwin.
  286. |
  287.     makePanes: bwin
  288.     | ww wh ph pw |
  289.         ww <- (bwin size) x.
  290.         wh <- (bwin size) y.
  291.         pw <- (ww / 2) truncated.
  292.         ph <- (wh / 5) truncated.
  293.         cp <- ClassPane new;
  294.                 openOn: classes in: bwin withSizeFrom: (-1 @ -1) to: (pw @ ph); parent: self.
  295.         mp <- MethodPane new;
  296.                 openOn: nil in: bwin withSizeFrom: ((pw - 1) @ -1) to: ((ww + 1) @ ph);
  297.                 parent: self.
  298.         ep <- EditorPane new;
  299.                 openIn: bwin withSizeFrom: (-1 @ (ph - 1)) to: ((ww + 1) @ (wh + 1));
  300.                 parent: self.
  301. |
  302.     setClass: c
  303.         ep setClass: c
  304. |
  305.     showClasses
  306.         cp setText
  307. |
  308.     showMethodsForClass: c
  309.         mp showMethodsForClass: c
  310. |
  311.     editClass: c
  312.         ep editClass: c
  313. |
  314.     editNewClass
  315.         ep editNewClass
  316. |
  317.     showMethods 
  318.         mp setText
  319. |
  320.     prepareMethodPane
  321.         mp clearPane
  322. |
  323.      editMethod: m
  324.          ep editMethod: m
  325. |
  326.     addNewMethod
  327.         ep editNewMethod
  328. |
  329.     cancelEditor
  330.         ep cancel
  331. |
  332.     close
  333.         " close our window and remove the pop-up menus"
  334.         cp close.
  335.         mp close.
  336.         ep close.
  337. ]
  338.